home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / GramC.mi < prev    next >
Text File  |  1992-11-24  |  24KB  |  1,136 lines
  1. IMPLEMENTATION MODULE GramC;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15. IMPORT SYSTEM, System, IO, Tree;
  16. (* line 5 "" *)
  17.  
  18.  
  19. FROM IO        IMPORT WriteS, WriteNl;
  20. FROM Strings    IMPORT tString, ArrayToString;
  21. FROM StringMem    IMPORT WriteString;
  22. FROM Idents    IMPORT NoIdent, tIdent, MakeIdent;
  23. FROM Texts    IMPORT WriteText;
  24. FROM Sets    IMPORT IsElement, Include;
  25. FROM TreeC2    IMPORT TreeIO;
  26.  
  27. FROM Tree    IMPORT
  28.    NoTree    , tTree        , Input        , Reverse    ,
  29.    Class    , NoClass    , Child        , Attribute    ,
  30.    ActionPart    , HasSelector    , HasAttributes    , NoCodeAttr    ,
  31.    Referenced    , Options    , TreeRoot    , QueryTree    ,
  32.    ClassCount    , iNoTree    , itTree    , Generated    ,
  33.    f        , WI, WE, WN    , ForallClasses    , ForallAttributes,
  34.    Nonterminal    , Terminal    , IdentifyAttribute,
  35.    String    , iPosition    ;
  36.  
  37. IMPORT Strings;
  38.  
  39. VAR
  40.    Node, ActClass, TheClass, TheAttr    : tTree;
  41.    iOper, iLeft, iRight, iNone, iPrec, iRule    : tIdent;
  42.    ActActionIndex, PrevActionIndex    : SHORTCARD;
  43.    IsImplicit                : BOOLEAN;
  44.    s                    : tString;
  45.  
  46. PROCEDURE GetBaseClass (Class: tTree): tTree;
  47.    BEGIN
  48.       WHILE Class^.Class.BaseClass^.Kind # NoClass DO
  49.      Class := Class^.Class.BaseClass;
  50.       END;
  51.       RETURN Class;
  52.    END GetBaseClass;
  53.  
  54. PROCEDURE IsLast (Class, Action: tTree): BOOLEAN;
  55.    VAR Found, Last: BOOLEAN;
  56.    BEGIN
  57.       IsLast2 (Class, Action, Found, Last);
  58.       RETURN Last;
  59.    END IsLast;
  60.  
  61. PROCEDURE IsLast2 (t, Action: tTree; VAR pFound, pLast: BOOLEAN);
  62.    VAR Found, Last: BOOLEAN;
  63.    BEGIN
  64.       CASE t^.Kind OF
  65.       | Class:
  66.         IsLast2 (t^.Class.Attributes, Action, pFound, pLast);
  67.         IF pFound OR NOT pLast THEN RETURN; END;
  68.         IsLast2 (t^.Class.BaseClass, Action, pFound, pLast);
  69.       | Child:
  70.         IsLast2 (t^.Child.Next, Action, Found, Last);
  71.         pFound := Found;
  72.         IF Found THEN
  73.            pLast := Last;
  74.         ELSE
  75.            pLast := FALSE;
  76.         END;
  77.       | Attribute:
  78.         IsLast2 (t^.Attribute.Next, Action, pFound, pLast);
  79.       | ActionPart:
  80.         IsLast2 (t^.ActionPart.Next, Action, Found, Last);
  81.         pFound := Found OR (Action = t);
  82.         IF Found THEN
  83.            pLast := Last;
  84.         ELSE
  85.            pLast := Last AND (Action = t);
  86.         END;
  87.       ELSE
  88.         pFound := FALSE;
  89.         pLast  := TRUE;
  90.       END;
  91.    END IsLast2;
  92.  
  93. PROCEDURE Prefix;
  94.    BEGIN
  95.       IF TreeRoot^.Ag.ScannerName # NoIdent THEN WI (TreeRoot^.Ag.ScannerName); WriteS (f, "_"); END;
  96.    END Prefix;
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197. PROCEDURE yyAbort (yyFunction: ARRAY OF CHAR);
  198.  BEGIN
  199.   IO.WriteS (IO.StdError, 'Error: module GramC, routine ');
  200.   IO.WriteS (IO.StdError, yyFunction);
  201.   IO.WriteS (IO.StdError, ' failed');
  202.   IO.WriteNl (IO.StdError);
  203.   Exit;
  204.  END yyAbort;
  205.  
  206. PROCEDURE yyIsEqual (yya, yyb: ARRAY OF SYSTEM.BYTE): BOOLEAN;
  207.  VAR yyi    : INTEGER;
  208.  BEGIN
  209.   FOR yyi := 0 TO INTEGER (HIGH (yya)) DO
  210.    IF yya [yyi] # yyb [yyi] THEN RETURN FALSE; END;
  211.   END;
  212.   RETURN TRUE;
  213.  END yyIsEqual;
  214.  
  215. PROCEDURE ParsSpec (t: Tree.tTree);
  216.  VAR yyTempo: RECORD CASE : INTEGER OF
  217.  END; END;
  218.  BEGIN
  219.   IF t = Tree.NoTree THEN RETURN; END;
  220.   IF (t^.Kind = Tree.Ag) THEN
  221. (* line 98 "" *)
  222.      WITH t^.Ag DO
  223. (* line 98 "" *)
  224.       
  225.     IF ScannerName # NoIdent THEN
  226.        WriteS (f, "SCANNER "); WI (ScannerName);
  227.     END;
  228.     WriteS (f, " PARSER "); WI (ParserName); WriteNl (f);
  229.     WriteS (f, "GLOBAL {"); WriteNl (f);
  230.     WriteText (f, ParserCodes^.Codes.Global);
  231.     Node := Modules;
  232.     WHILE Node^.Kind = Tree.Module DO
  233.        WriteText (f, Node^.Module.ParserCodes^.Codes.Global);
  234.        Node := Node^.Module.Next;
  235.     END;
  236.         ParsVariant (Classes);
  237.     WriteNl (f);
  238.     WriteS (f, "typedef union {"); WriteNl (f);
  239.     WriteS (f, " "); Prefix; WriteS (f, "tScanAttribute Scan;"); WriteNl (f);
  240.     Node := Classes;
  241.     WHILE Node^.Kind = Class DO
  242.       WITH Node^.Class DO
  243.          IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  244.            IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  245.          WriteS (f, " yy"); WN (Name); WriteS (f, " /* "); WE (Name); WriteS (f, " */ yy"); WN (Name); WriteS (f, ";"); WriteNl (f);
  246.            ELSE
  247.          WriteS (f, " yy"); WI (Selector); WriteS (f, " "); WI (Selector); WriteS (f, ";"); WriteNl (f);
  248.            END;
  249.          END;
  250.          Node := Next;
  251.       END;
  252.     END;
  253.     WriteS (f, "} tParsAttribute;"); WriteNl (f);
  254.     WriteS (f, "}"); WriteNl (f);
  255.     WriteNl (f);
  256.     WriteS (f, "EXPORT {"); WriteNl (f);
  257.     WriteText (f, ParserCodes^.Codes.Export);
  258.     Node := Modules;
  259.     WHILE Node^.Kind = Tree.Module DO
  260.       WriteText (f, Node^.Module.ParserCodes^.Codes.Export);
  261.       Node := Node^.Module.Next;
  262.     END;
  263.     WriteS (f, "}"); WriteNl (f);
  264.     WriteNl (f);
  265.     WriteS (f, "LOCAL {"); WriteNl (f);
  266.     WriteText (f, ParserCodes^.Codes.Local);
  267.     Node := Modules;
  268.     WHILE Node^.Kind = Tree.Module DO
  269.       WriteText (f, Node^.Module.ParserCodes^.Codes.Local);
  270.       Node := Node^.Module.Next;
  271.     END;
  272.     WriteS (f, "}"); WriteNl (f);
  273.     WriteNl (f);
  274.     WriteS (f, "BEGIN {"); WriteNl (f);
  275.     WriteText (f, ParserCodes^.Codes.Begin);
  276.     Node := Modules;
  277.     WHILE Node^.Kind = Tree.Module DO
  278.       WriteText (f, Node^.Module.ParserCodes^.Codes.Begin);
  279.       Node := Node^.Module.Next;
  280.     END;
  281.     WriteS (f, "}"); WriteNl (f);
  282.     WriteNl (f);
  283.     WriteS (f, "CLOSE {"); WriteNl (f);
  284.     WriteText (f, ParserCodes^.Codes.Close);
  285.     Node := Modules;
  286.     WHILE Node^.Kind = Tree.Module DO
  287.       WriteText (f, Node^.Module.ParserCodes^.Codes.Close);
  288.       Node := Node^.Module.Next;
  289.     END;
  290.     WriteS (f, "}"); WriteNl (f);
  291.     WriteNl (f);
  292.     WriteS (f, "TOKEN"); WriteNl (f);
  293.     WriteNl (f);
  294.     ForallClasses (Classes, Token);
  295.     WriteNl (f);
  296.     WriteS (f, "OPER"); WriteNl (f);
  297.     WriteNl (f);
  298.     PrecDefs (Precs);
  299.     WriteNl (f);
  300.     WriteS (f, "RULE"); WriteNl (f);
  301.     WriteNl (f);
  302.     ForallClasses (Classes, ParsSpec);
  303. ;
  304.       RETURN;
  305.      END;
  306.  
  307.   END;
  308.   IF (t^.Kind = Tree.Class) THEN
  309. (* line 178 "" *)
  310.      WITH t^.Class DO
  311. (* line 178 "" *)
  312.       
  313.     IF {Nonterminal, Referenced} <= Properties THEN
  314.        TheClass := t;
  315.        Grammar (t);
  316.     END;
  317. ;
  318.       RETURN;
  319.      END;
  320.  
  321.   END;
  322.  END ParsSpec;
  323.  
  324. PROCEDURE ScanSpec (t: Tree.tTree);
  325.  VAR yyTempo: RECORD CASE : INTEGER OF
  326.  END; END;
  327.  BEGIN
  328.   IF t = Tree.NoTree THEN RETURN; END;
  329.   IF (t^.Kind = Tree.Ag) THEN
  330. (* line 188 "" *)
  331.      WITH t^.Ag DO
  332. (* line 188 "" *)
  333.       
  334.     WriteS (f, "c"); WriteNl (f);
  335.     WriteS (f, "# if defined __STDC__ | defined __cplusplus"); WriteNl (f);
  336.     WriteS (f, "# define ARGS(parameters)    parameters"); WriteNl (f);
  337.     WriteS (f, "# else"); WriteNl (f);
  338.     WriteS (f, "# define ARGS(parameters)    ()"); WriteNl (f);
  339.     WriteS (f, "# endif"); WriteNl (f);
  340.     WriteNl (f);
  341.     ForallClasses (Classes, ScanVariant);
  342.     WriteNl (f);
  343.     WriteS (f, "typedef union {"); WriteNl (f);
  344.     WriteS (f, " tPosition Position;"); WriteNl (f);
  345.     ForallClasses (Classes, ScanAttr);
  346.     WriteS (f, "} "); Prefix; WriteS (f, "tScanAttribute;"); WriteNl (f);
  347.     WriteNl (f);
  348.     WriteS (f, "extern void "); Prefix; WriteS (f, "ErrorAttribute ARGS((int Token, "); Prefix; WriteS (f, "tScanAttribute * pAttribute));"); WriteNl (f);
  349.     WriteS (f, "%%"); WriteNl (f);
  350.     WriteS (f, "void "); Prefix; WriteS (f, "ErrorAttribute"); WriteNl (f);
  351.     WriteS (f, "# if defined __STDC__ | defined __cplusplus"); WriteNl (f);
  352.     WriteS (f, " (int Token, "); Prefix; WriteS (f, "tScanAttribute * pAttribute)"); WriteNl (f);
  353.     WriteS (f, "# else"); WriteNl (f);
  354.     WriteS (f, " (Token, pAttribute) int Token; "); Prefix; WriteS (f, "tScanAttribute * pAttribute;"); WriteNl (f);
  355.     WriteS (f, "# endif"); WriteNl (f);
  356.     WriteS (f, "{"); WriteNl (f);
  357.     WriteS (f, " pAttribute->Position = "); Prefix; WriteS (f, "Attribute.Position;"); WriteNl (f);
  358.     WriteS (f, " switch (Token) {"); WriteNl (f);
  359.     ForallClasses (Classes, ErrorActions);
  360.     WriteS (f, " }"); WriteNl (f);
  361.     WriteS (f, "}"); WriteNl (f);
  362.     WriteS (f, "%%"); WriteNl (f);
  363.     ForallClasses (Classes, ScanSpec);
  364. ;
  365.       RETURN;
  366.      END;
  367.  
  368.   END;
  369.   IF (t^.Kind = Tree.Class) THEN
  370. (* line 220 "" *)
  371.      WITH t^.Class DO
  372. (* line 220 "" *)
  373.       
  374.     IF {Terminal, Referenced} <= Properties THEN
  375.        WN (Code);
  376.        IF HasAttributes IN Properties THEN    WriteS (f, " S "); 
  377.        ELSE                    WriteS (f, " N "); 
  378.        END;
  379.        IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  380.           WriteS (f, "yy"); WN (Code);
  381.        ELSE
  382.           WI (Selector);
  383.        END;
  384.        WriteS (f, " "); WI (Name); WriteNl (f);
  385.     END;
  386. ;
  387.       RETURN;
  388.      END;
  389.  
  390.   END;
  391.  END ScanSpec;
  392.  
  393. PROCEDURE ErrorActions (t: Tree.tTree);
  394.  VAR yyTempo: RECORD CASE : INTEGER OF
  395.  END; END;
  396.  BEGIN
  397.   IF t = Tree.NoTree THEN RETURN; END;
  398.  
  399.   CASE t^.Kind OF
  400.   | Tree.Class:
  401. (* line 238 "" *)
  402.      WITH t^.Class DO
  403. (* line 238 "" *)
  404.       
  405.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  406.       WriteS (f, " case /* "); WE (Name); WriteS (f, " */ "); WN (Code); WriteS (f, ": "); WriteNl (f);
  407.       TheClass := t;
  408.       ForallAttributes (t, ErrorActions);
  409.       WriteS (f, " break;"); WriteNl (f);
  410.     END;
  411. ;
  412.       RETURN;
  413.      END;
  414.  
  415.   | Tree.ActionPart:
  416. (* line 246 "" *)
  417.      WITH t^.ActionPart DO
  418. (* line 246 "" *)
  419.       
  420.     ErrorActions (Actions);
  421. ;
  422.       RETURN;
  423.      END;
  424.  
  425.   | Tree.Assign:
  426. (* line 249 "" *)
  427.      WITH t^.Assign DO
  428. (* line 249 "" *)
  429.       
  430.     ErrorActions (Results); WriteS (f, "="); ErrorActions (Arguments); WriteS (f, ";"); WriteNl (f);
  431.     ErrorActions (Next);
  432. ;
  433.       RETURN;
  434.      END;
  435.  
  436.   | Tree.Copy:
  437. (* line 253 "" *)
  438.      WITH t^.Copy DO
  439. (* line 253 "" *)
  440.       
  441.     ErrorActions (Results); WriteS (f, " = "); ErrorActions (Arguments); WriteS (f, ";"); WriteNl (f);
  442.     ErrorActions (Next);
  443. ;
  444.       RETURN;
  445.      END;
  446.  
  447.   | Tree.TargetCode:
  448. (* line 257 "" *)
  449.      WITH t^.TargetCode DO
  450. (* line 257 "" *)
  451.       
  452.     ErrorActions (Code); WriteS (f, ";"); WriteNl (f);
  453.     ErrorActions (Next);
  454. ;
  455.       RETURN;
  456.      END;
  457.  
  458.   | Tree.Order:
  459. (* line 261 "" *)
  460.      WITH t^.Order DO
  461. (* line 261 "" *)
  462.       
  463.     ErrorActions (Next);
  464. ;
  465.       RETURN;
  466.      END;
  467.  
  468.   | Tree.Check:
  469. (* line 264 "" *)
  470.      WITH t^.Check DO
  471. (* line 264 "" *)
  472.       
  473.     IF Statement # NoTree THEN
  474.        IF Condition # NoTree THEN
  475.           WriteS (f, "if ("); ErrorActions (Condition); WriteS (f, ") ; else { "); ErrorActions (Statement); WriteS (f, "; }"); WriteNl (f);
  476.        ELSE
  477.           WriteS (f, "{ "); ErrorActions (Statement); WriteS (f, "; }"); WriteNl (f);
  478.        END;
  479.     ELSE
  480.        WriteS (f, "(void) ("); ErrorActions (Condition); WriteS (f, ");"); WriteNl (f);
  481.     END;
  482.     ErrorActions (Next);
  483. ;
  484.       RETURN;
  485.      END;
  486.  
  487.   | Tree.Designator:
  488. (* line 276 "" *)
  489.      WITH t^.Designator DO
  490. (* line 276 "" *)
  491.       
  492.     WI (Selector); WriteS (f, ":"); WI (Attribute);
  493.     ErrorActions (Next);
  494. ;
  495.       RETURN;
  496.      END;
  497.  
  498.   | Tree.Ident:
  499. (* line 280 "" *)
  500.      WITH t^.Ident DO
  501. (* line 280 "" *)
  502.       
  503.     TheAttr := IdentifyAttribute (TheClass, Attribute);
  504.     IF TheAttr # NoTree THEN
  505.        WriteS (f, "pAttribute->"); 
  506.        IF Attribute = iPosition THEN
  507.            ELSIF (String IN TheClass^.Class.Properties) AND NOT (HasSelector IN TheClass^.Class.Properties) THEN
  508.           WriteS (f, "yy"); WN (TheClass^.Class.Code); WriteS (f, "."); 
  509.        ELSE
  510.           WI (TheClass^.Class.Selector); WriteS (f, "."); 
  511.        END;
  512.     END;
  513.     WI (Attribute);
  514.     ErrorActions (Next);
  515. ;
  516.       RETURN;
  517.      END;
  518.  
  519.   | Tree.Any:
  520. (* line 294 "" *)
  521.      WITH t^.Any DO
  522. (* line 294 "" *)
  523.       
  524.     WriteString (f, Code);
  525.     ErrorActions (Next);
  526. ;
  527.       RETURN;
  528.      END;
  529.  
  530.   | Tree.Anys:
  531. (* line 298 "" *)
  532.      WITH t^.Anys DO
  533. (* line 298 "" *)
  534.       
  535.     ErrorActions (Layouts);
  536.     ErrorActions (Next);
  537. ;
  538.       RETURN;
  539.      END;
  540.  
  541.   | Tree.LayoutAny:
  542. (* line 302 "" *)
  543.      WITH t^.LayoutAny DO
  544. (* line 302 "" *)
  545.       
  546.     WriteString (f, Code);
  547.     ErrorActions (Next);
  548. ;
  549.       RETURN;
  550.      END;
  551.  
  552.   ELSE END;
  553.  
  554.  END ErrorActions;
  555.  
  556. PROCEDURE ScanVariant (t: Tree.tTree);
  557.  VAR yyTempo: RECORD CASE : INTEGER OF
  558.  END; END;
  559.  BEGIN
  560.   IF t = Tree.NoTree THEN RETURN; END;
  561.   IF (t^.Kind = Tree.Class) THEN
  562. (* line 310 "" *)
  563.      WITH t^.Class DO
  564. (* line 310 "" *)
  565.       
  566.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  567.       WriteS (f, "typedef struct { tPosition yyPos; "); 
  568.       TheClass := t;
  569.       ForallAttributes (t, RecordField);
  570.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  571.         WriteS (f, "} /* "); WE (Name); WriteS (f, " */ yy"); WN (Code); WriteS (f, ";"); WriteNl (f);
  572.       ELSE
  573.         WriteS (f, "} yy"); WI (Selector); WriteS (f, ";"); WriteNl (f);
  574.       END;
  575.     END;
  576. ;
  577.       RETURN;
  578.      END;
  579.  
  580.   END;
  581.  END ScanVariant;
  582.  
  583. PROCEDURE ScanAttr (t: Tree.tTree);
  584.  VAR yyTempo: RECORD CASE : INTEGER OF
  585.  END; END;
  586.  BEGIN
  587.   IF t = Tree.NoTree THEN RETURN; END;
  588.   IF (t^.Kind = Tree.Class) THEN
  589. (* line 326 "" *)
  590.      WITH t^.Class DO
  591. (* line 326 "" *)
  592.       
  593.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  594.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  595.         WriteS (f, " yy"); WN (Code); WriteS (f, " /* "); WE (Name); WriteS (f, " */ yy"); WN (Code); WriteS (f, ";"); WriteNl (f);
  596.       ELSE
  597.         WriteS (f, " yy"); WI (Selector); WriteS (f, " "); WI (Selector); WriteS (f, ";"); WriteNl (f);
  598.       END;
  599.     END;
  600. ;
  601.       RETURN;
  602.      END;
  603.  
  604.   END;
  605.  END ScanAttr;
  606.  
  607. PROCEDURE ParsVariant (t: Tree.tTree);
  608.  VAR yyTempo: RECORD CASE : INTEGER OF
  609.  END; END;
  610.  BEGIN
  611.   IF t = Tree.NoTree THEN RETURN; END;
  612.   IF (t^.Kind = Tree.Class) THEN
  613. (* line 339 "" *)
  614.      WITH t^.Class DO
  615. (* line 339 "" *)
  616.       
  617.     IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  618.       WriteS (f, "typedef struct { "); 
  619.       TheClass := t;
  620.       ForallAttributes (Attributes, RecordField);
  621.       GenExt (Extensions);
  622.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  623.         WriteS (f, "} /* "); WE (Name); WriteS (f, " */ yy"); WN (Name); WriteS (f, ";"); WriteNl (f);
  624.       ELSE
  625.         WriteS (f, "} yy"); WI (Selector); WriteS (f, ";"); WriteNl (f);
  626.       END;
  627.     END;
  628.     ParsVariant (Next);
  629. ;
  630.       RETURN;
  631.      END;
  632.  
  633.   END;
  634.  END ParsVariant;
  635.  
  636. PROCEDURE GenExt (t: Tree.tTree);
  637.  VAR yyTempo: RECORD CASE : INTEGER OF
  638.  END; END;
  639.  BEGIN
  640.   IF t = Tree.NoTree THEN RETURN; END;
  641.   IF (t^.Kind = Tree.Class) THEN
  642. (* line 357 "" *)
  643.      WITH t^.Class DO
  644. (* line 357 "" *)
  645.       
  646.     ForallAttributes (Attributes, RecordField);
  647.     GenExt (Extensions);
  648.     GenExt (Next);
  649. ;
  650.       RETURN;
  651.      END;
  652.  
  653.   END;
  654.  END GenExt;
  655.  
  656. PROCEDURE Token (t: Tree.tTree);
  657.  VAR yyTempo: RECORD CASE : INTEGER OF
  658.  END; END;
  659.  BEGIN
  660.   IF t = Tree.NoTree THEN RETURN; END;
  661.   IF (t^.Kind = Tree.Class) THEN
  662. (* line 366 "" *)
  663.      WITH t^.Class DO
  664. (* line 366 "" *)
  665.       
  666.     IF {Terminal, Referenced} <= Properties THEN
  667.        WriteName (Name); WriteS (f, " = "); WN (Code); WriteNl (f);
  668.     END;
  669. ;
  670.       RETURN;
  671.      END;
  672.  
  673.   END;
  674.  END Token;
  675.  
  676. PROCEDURE RecordField (t: Tree.tTree);
  677.  VAR yyTempo: RECORD CASE : INTEGER OF
  678.  END; END;
  679.  BEGIN
  680.   IF t = Tree.NoTree THEN RETURN; END;
  681.   IF (t^.Kind = Tree.Attribute) THEN
  682. (* line 375 "" *)
  683.      WITH t^.Attribute DO
  684. (* line 375 "" *)
  685.       
  686.     IF (NoCodeAttr * Properties) = {} THEN 
  687.        IF (Nonterminal IN TheClass^.Class.Properties) OR (Name # iPosition) THEN
  688.           WI (Type); WriteS (f, " "); WI (Name); WriteS (f, "; "); 
  689.        END;
  690.     END;
  691. ;
  692.       RETURN;
  693.      END;
  694.  
  695.   END;
  696.  END RecordField;
  697.  
  698. PROCEDURE PrecDefs (t: Tree.tTree);
  699.  VAR yyTempo: RECORD CASE : INTEGER OF
  700.  END; END;
  701.  BEGIN
  702.   IF t = Tree.NoTree THEN RETURN; END;
  703.   IF (t^.Kind = Tree.LeftAssoc) THEN
  704. (* line 386 "" *)
  705.      WITH t^.LeftAssoc DO
  706. (* line 386 "" *)
  707.       
  708.     WriteS (f, "LEFT "); PrecDefs (Names); WriteNl (f);
  709.     PrecDefs (Next);
  710. ;
  711.       RETURN;
  712.      END;
  713.  
  714.   END;
  715.   IF (t^.Kind = Tree.RightAssoc) THEN
  716. (* line 390 "" *)
  717.      WITH t^.RightAssoc DO
  718. (* line 390 "" *)
  719.       
  720.     WriteS (f, "RIGHT"); PrecDefs (Names); WriteNl (f);
  721.     PrecDefs (Next);
  722. ;
  723.       RETURN;
  724.      END;
  725.  
  726.   END;
  727.   IF (t^.Kind = Tree.NonAssoc) THEN
  728. (* line 394 "" *)
  729.      WITH t^.NonAssoc DO
  730. (* line 394 "" *)
  731.       
  732.     WriteS (f, "NONE "); PrecDefs (Names); WriteNl (f);
  733.     PrecDefs (Next);
  734. ;
  735.       RETURN;
  736.      END;
  737.  
  738.   END;
  739.   IF (t^.Kind = Tree.Name) THEN
  740. (* line 398 "" *)
  741.      WITH t^.Name DO
  742. (* line 398 "" *)
  743.       
  744.     WriteS (f, " "); WI (Name);
  745.     PrecDefs (Next);
  746. ;
  747.       RETURN;
  748.      END;
  749.  
  750.   END;
  751.  END PrecDefs;
  752.  
  753. PROCEDURE Grammar (t: Tree.tTree);
  754.  VAR yyTempo: RECORD CASE : INTEGER OF
  755.  END; END;
  756.  BEGIN
  757.   IF t = Tree.NoTree THEN RETURN; END;
  758.   IF (t^.Kind = Tree.Class) THEN
  759. (* line 406 "" *)
  760.      WITH t^.Class DO
  761. (* line 406 "" *)
  762.       
  763.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  764.        WITH TheClass^.Class DO
  765.           IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WriteName (Name); END;
  766.        END;
  767.        WriteS (f, " : "); 
  768.        ActClass := t;
  769.        PrevActionIndex := 0;
  770.        IsImplicit := FALSE;
  771.        ForallAttributes (t, Rule);
  772.        IF Prec # NoIdent THEN WriteS (f, "PREC "); WI (Prec); WriteS (f, " "); END;
  773.        WriteS (f, "."); WriteNl (f);
  774.        PrevActionIndex := 0;
  775.        IsImplicit := TRUE;
  776.        ForallAttributes (t, Implicit);
  777.     ELSE
  778.        Rule (Extensions);
  779.     END;
  780. ;
  781.       RETURN;
  782.      END;
  783.  
  784.   END;
  785.  END Grammar;
  786.  
  787. PROCEDURE Rule (t: Tree.tTree);
  788.  VAR yyTempo: RECORD CASE : INTEGER OF
  789.  END; END;
  790.  BEGIN
  791.   IF t = Tree.NoTree THEN RETURN; END;
  792.  
  793.   CASE t^.Kind OF
  794.   | Tree.Class:
  795. (* line 429 "" *)
  796.      WITH t^.Class DO
  797. (* line 429 "" *)
  798.       
  799.     Grammar (t);
  800.     Rule (Next);
  801. ;
  802.       RETURN;
  803.      END;
  804.  
  805.   | Tree.Child:
  806. (* line 433 "" *)
  807.      WITH t^.Child DO
  808. (* line 433 "" *)
  809.       
  810.     IF {String, Nonterminal} <= Class^.Class.Properties THEN WriteS (f, "yy"); WN (Type); ELSE WriteName (Type); END; WriteS (f, " "); 
  811. ;
  812.       RETURN;
  813.      END;
  814.  
  815.   | Tree.ActionPart:
  816. (* line 436 "" *)
  817.      WITH t^.ActionPart DO
  818. (* line 436 "" *)
  819.       
  820.     IF IsLast (ActClass, t) THEN
  821.        WriteS (f, "{"); 
  822.        IF PrevActionIndex # 0 THEN
  823.           Node := GetBaseClass (TheClass);
  824.           WITH Node^.Class DO
  825.          IF HasAttributes IN Properties THEN
  826.             WriteS (f, " $$."); 
  827.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  828.             WriteS (f, " = $"); WN (PrevActionIndex); WriteS (f, "."); 
  829.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  830.             WriteS (f, ";"); WriteNl (f);
  831.          END;
  832.           END;
  833.        END;
  834.        Rule (Actions);
  835.        WriteS (f, "} "); 
  836.     ELSE
  837.        WriteS (f, "xx"); WN (Name); WriteS (f, " "); 
  838.     END;
  839.     PrevActionIndex := ParsIndex;
  840. ;
  841.       RETURN;
  842.      END;
  843.  
  844.   | Tree.Assign:
  845. (* line 458 "" *)
  846.      WITH t^.Assign DO
  847. (* line 458 "" *)
  848.       
  849.     Rule (Results); WriteS (f, "="); Rule (Arguments); WriteS (f, ";"); WriteNl (f);
  850.     Rule (Next);
  851. ;
  852.       RETURN;
  853.      END;
  854.  
  855.   | Tree.Copy:
  856. (* line 462 "" *)
  857.      WITH t^.Copy DO
  858. (* line 462 "" *)
  859.       
  860.     Rule (Results); WriteS (f, " = "); Rule (Arguments); WriteS (f, ";"); WriteNl (f);
  861.     Rule (Next);
  862. ;
  863.       RETURN;
  864.      END;
  865.  
  866.   | Tree.TargetCode:
  867. (* line 466 "" *)
  868.      WITH t^.TargetCode DO
  869. (* line 466 "" *)
  870.       
  871.     Rule (Code); WriteS (f, ";"); WriteNl (f);
  872.     Rule (Next);
  873. ;
  874.       RETURN;
  875.      END;
  876.  
  877.   | Tree.Order:
  878. (* line 470 "" *)
  879.      WITH t^.Order DO
  880. (* line 470 "" *)
  881.       
  882.     Rule (Next);
  883. ;
  884.       RETURN;
  885.      END;
  886.  
  887.   | Tree.Check:
  888. (* line 473 "" *)
  889.      WITH t^.Check DO
  890. (* line 473 "" *)
  891.       
  892.     IF Statement # NoTree THEN
  893.        IF Condition # NoTree THEN
  894.           WriteS (f, "if ("); Rule (Condition); WriteS (f, ") ; else { "); Rule (Statement); WriteS (f, "; }"); WriteNl (f);
  895.        ELSE
  896.           WriteS (f, "{ "); Rule (Statement); WriteS (f, "; }"); 
  897.        END;
  898.     ELSE
  899.        WriteS (f, "(void) ("); Rule (Condition); WriteS (f, ");"); WriteNl (f);
  900.     END;
  901.     Rule (Next);
  902. ;
  903.       RETURN;
  904.      END;
  905.  
  906.   | Tree.Designator:
  907. (* line 485 "" *)
  908.      WITH t^.Designator DO
  909. (* line 485 "" *)
  910.       
  911.     TheAttr := IdentifyAttribute (ActClass, Selector);
  912.     IF TheAttr # NoTree THEN
  913.       Node := TheAttr^.Child.Class;
  914.       IF Node # NoTree THEN
  915.         WriteS (f, "$"); 
  916.         IF NOT IsImplicit THEN
  917.            WN (TheAttr^.Child.ParsIndex);
  918.         ELSE
  919.            WN (SHORTINT (TheAttr^.Child.ParsIndex + 1 - ActActionIndex));
  920.         END;
  921.         IF Nonterminal IN Node^.Class.Properties THEN    (* nonterminal *)
  922.           Node := GetBaseClass (Node);
  923.           IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  924.             WriteS (f, ".yy"); WN (Node^.Class.Name);
  925.           ELSE
  926.             WriteS (f, "."); WI (Node^.Class.Name);
  927.           END;
  928.         ELSE                        (* terminal *)
  929.           WriteS (f, ".Scan"); 
  930.           IF Attribute = iPosition THEN
  931.           ELSIF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  932.             WriteS (f, ".yy"); WN (Node^.Class.Code);
  933.           ELSE
  934.             WriteS (f, "."); WI (Node^.Class.Selector);
  935.           END;
  936.         END;
  937.         WriteS (f, "."); WI (Attribute);
  938.       ELSE
  939.         WI (Selector); WriteS (f, ":"); WI (Attribute);
  940.       END;
  941.     ELSE
  942.       WI (Selector); WriteS (f, ":"); WI (Attribute);
  943.     END;
  944.     Rule (Next);
  945. ;
  946.       RETURN;
  947.      END;
  948.  
  949.   | Tree.Ident:
  950. (* line 521 "" *)
  951.      WITH t^.Ident DO
  952. (* line 521 "" *)
  953.       
  954.     TheAttr := IdentifyAttribute (ActClass, Attribute);
  955.     Node := GetBaseClass (TheClass);
  956.     IF TheAttr # NoTree THEN
  957.       IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  958.         WriteS (f, "$$.yy"); WN (Node^.Class.Name); WriteS (f, "."); WI (Attribute);
  959.       ELSE
  960.         WriteS (f, "$$."); WI (Node^.Class.Name); WriteS (f, "."); WI (Attribute);
  961.       END;
  962.     ELSE
  963.       WI (Attribute);
  964.     END;
  965.     Rule (Next);
  966. ;
  967.       RETURN;
  968.      END;
  969.  
  970.   | Tree.Any:
  971. (* line 535 "" *)
  972.      WITH t^.Any DO
  973. (* line 535 "" *)
  974.       
  975.     WriteString (f, Code);
  976.     Rule (Next);
  977. ;
  978.       RETURN;
  979.      END;
  980.  
  981.   | Tree.Anys:
  982. (* line 539 "" *)
  983.      WITH t^.Anys DO
  984. (* line 539 "" *)
  985.       
  986.     Rule (Layouts);
  987.     Rule (Next);
  988. ;
  989.       RETURN;
  990.      END;
  991.  
  992.   | Tree.LayoutAny:
  993. (* line 543 "" *)
  994.      WITH t^.LayoutAny DO
  995. (* line 543 "" *)
  996.       
  997.     WriteString (f, Code);
  998.     Rule (Next);
  999. ;
  1000.       RETURN;
  1001.      END;
  1002.  
  1003.   ELSE END;
  1004.  
  1005.  END Rule;
  1006.  
  1007. PROCEDURE Implicit (t: Tree.tTree);
  1008.  VAR yyTempo: RECORD CASE : INTEGER OF
  1009.  END; END;
  1010.  BEGIN
  1011.   IF t = Tree.NoTree THEN RETURN; END;
  1012.   IF (t^.Kind = Tree.ActionPart) THEN
  1013. (* line 551 "" *)
  1014.      WITH t^.ActionPart DO
  1015. (* line 551 "" *)
  1016.       
  1017.     IF NOT (Generated IN Properties) AND NOT IsLast (ActClass, t) THEN
  1018.        INCL (Properties, Generated);
  1019.        ActActionIndex := ParsIndex;
  1020.        WriteS (f, "xx"); WN (Name); WriteS (f, " : {"); 
  1021.        IF PrevActionIndex # 0 THEN
  1022.           Node := GetBaseClass (TheClass);
  1023.           WITH Node^.Class DO
  1024.          IF HasAttributes IN Properties THEN
  1025.             WriteS (f, " $$."); 
  1026.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  1027.             WriteS (f, " = $"); WN (SHORTINT (PrevActionIndex + 1 - ActActionIndex)); WriteS (f, "."); 
  1028.             IF String IN Properties THEN WriteS (f, "yy"); WN (Name); ELSE WI (Name); END;
  1029.             WriteS (f, ";"); WriteNl (f);
  1030.          END;
  1031.           END;
  1032.        END;
  1033.        Rule (Actions);
  1034.        WriteS (f, "} ."); WriteNl (f);
  1035.     END;
  1036.     PrevActionIndex := ParsIndex;
  1037. ;
  1038.       RETURN;
  1039.      END;
  1040.  
  1041.   END;
  1042.  END Implicit;
  1043.  
  1044. PROCEDURE WriteName (Name: tIdent);
  1045.  VAR yyTempo: RECORD CASE : INTEGER OF
  1046.  END; END;
  1047.  BEGIN
  1048.   IF (Name =  (iOper)) THEN
  1049. (* line 576 "" *)
  1050. (* line 581 "" *)
  1051.       WriteS (f, "\");
  1052. (* line 581 "" *)
  1053.       WI (Name);
  1054.       RETURN;
  1055.  
  1056.   END;
  1057.   IF (Name =  (iLeft)) THEN
  1058. (* line 576 "" *)
  1059. (* line 581 "" *)
  1060.       WriteS (f, "\");
  1061. (* line 581 "" *)
  1062.       WI (Name);
  1063.       RETURN;
  1064.  
  1065.   END;
  1066.   IF (Name =  (iRight)) THEN
  1067. (* line 576 "" *)
  1068. (* line 581 "" *)
  1069.       WriteS (f, "\");
  1070. (* line 581 "" *)
  1071.       WI (Name);
  1072.       RETURN;
  1073.  
  1074.   END;
  1075.   IF (Name =  (iNone)) THEN
  1076. (* line 576 "" *)
  1077. (* line 581 "" *)
  1078.       WriteS (f, "\");
  1079. (* line 581 "" *)
  1080.       WI (Name);
  1081.       RETURN;
  1082.  
  1083.   END;
  1084.   IF (Name =  (iPrec)) THEN
  1085. (* line 576 "" *)
  1086. (* line 581 "" *)
  1087.       WriteS (f, "\");
  1088. (* line 581 "" *)
  1089.       WI (Name);
  1090.       RETURN;
  1091.  
  1092.   END;
  1093.   IF (Name =  (iRule)) THEN
  1094. (* line 576 "" *)
  1095. (* line 581 "" *)
  1096.       WriteS (f, "\");
  1097. (* line 581 "" *)
  1098.       WI (Name);
  1099.       RETURN;
  1100.  
  1101.   END;
  1102. (* line 582 "" *)
  1103. (* line 582 "" *)
  1104.       WI (Name);
  1105.       RETURN;
  1106.  
  1107.  END WriteName;
  1108.  
  1109. PROCEDURE BeginGramC;
  1110.  BEGIN
  1111. (* line 87 "" *)
  1112.  
  1113.    ArrayToString ("OPER"    , s); iOper    := MakeIdent (s);
  1114.    ArrayToString ("RIGHT"    , s); iRight    := MakeIdent (s);
  1115.    ArrayToString ("LEFT"    , s); iLeft    := MakeIdent (s);
  1116.    ArrayToString ("NONE"    , s); iNone    := MakeIdent (s);
  1117.    ArrayToString ("PREC"    , s); iPrec    := MakeIdent (s);
  1118.    ArrayToString ("RULE"    , s); iRule    := MakeIdent (s);
  1119.  
  1120.  END BeginGramC;
  1121.  
  1122. PROCEDURE CloseGramC;
  1123.  BEGIN
  1124.  END CloseGramC;
  1125.  
  1126. PROCEDURE yyExit;
  1127.  BEGIN
  1128.   IO.CloseIO; System.Exit (1);
  1129.  END yyExit;
  1130.  
  1131. BEGIN
  1132.  yyf    := IO.StdOutput;
  1133.  Exit    := yyExit;
  1134.  BeginGramC;
  1135. END GramC.
  1136.